home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr47 / alt_lan.zip / BOB.ASC next >
Text File  |  1995-02-02  |  16KB  |  670 lines
  1. _BOB: A TINY OBJECT-ORIENTED LANGUAGE_
  2. by David Betz
  3.  
  4. [LISTING ONE]
  5.  
  6. /* bobint.c - bytecode interpreter */
  7. /*
  8.     Copyright (c) 1991, by David Michael Betz
  9.     All rights reserved
  10. */
  11.  
  12. #include <setjmp.h>
  13. #include "bob.h"
  14.  
  15. #define iszero(x)   ((x)->v_type == DT_INTEGER && (x)->v.v_integer == 0)
  16. #define istrue(x)   ((x)->v_type != DT_NIL && !iszero(x))
  17.  
  18. /* global variables */
  19. VALUE *stkbase;     /* the runtime stack */
  20. VALUE *stktop;      /* the top of the stack */
  21. VALUE *sp;      /* the stack pointer */
  22. VALUE *fp;      /* the frame pointer */ int trace=0;        /* variable to control tracing */
  23.  
  24. /* external variables */
  25. extern DICTIONARY *symbols;
  26. extern jmp_buf error_trap;
  27.  
  28. /* local variables */
  29. static unsigned char *cbase;    /* the base code address */
  30. static unsigned char *pc;   /* the program counter */
  31. static VALUE *code;     /* the current code vector */
  32.  
  33. /* forward declarations */
  34. char *typename();
  35.  
  36. /* execute - execute a bytecode function */
  37. int execute(name)
  38.   char *name;
  39. {
  40.     DICT_ENTRY *sym;
  41.     
  42.     /* setup an error trap handler */
  43.     if (setjmp(error_trap) != 0)
  44.     return (FALSE);
  45.  
  46.     /* lookup the symbol */
  47.     if ((sym = findentry(symbols,name)) == NULL)
  48.     return (FALSE);
  49.  
  50.     /* dispatch on its data type */
  51.     switch (sym->de_value.v_type) {
  52.     case DT_CODE:
  53.     (*sym->de_value.v.v_code)(0);
  54.     break;
  55.     case DT_BYTECODE:
  56.     interpret(sym->de_value.v.v_bytecode);
  57.     break;
  58.     }
  59.     return (TRUE);
  60. }
  61.  
  62. /* interpret - interpret bytecode instructions */
  63. int interpret(fcn)
  64.   VALUE *fcn;
  65. {
  66.     register int pcoff,n;
  67.     register VALUE *obj;
  68.     VALUE *topframe,val;
  69.     STRING *s1,*s2,*sn;
  70.     
  71.     /* initialize */
  72.     sp = fp = stktop;
  73.     cbase = pc = fcn[1].v.v_string->s_data;
  74.     code = fcn;
  75.  
  76.     /* make a dummy call frame */     check(4);
  77.     push_bytecode(code);
  78.     push_integer(0);
  79.     push_integer(0);
  80.     push_integer(0);
  81.     fp = topframe = sp;
  82.     
  83.     /* execute each instruction */
  84.     for (;;) {
  85.     if (trace)
  86.         decode_instruction(code,pc-code[1].v.v_string->s_data);
  87.     switch (*pc++) {
  88.     case OP_CALL:
  89.         n = *pc++;
  90.         switch (sp[n].v_type) {
  91.         case DT_CODE:
  92.             (*sp[n].v.v_code)(n);
  93.             break;
  94.         case DT_BYTECODE:
  95.             check(3);
  96.             code = sp[n].v.v_bytecode;
  97.             push_integer(n);
  98.             push_integer(stktop - fp);
  99.             push_integer(pc - cbase);
  100.             cbase = pc = code[1].v.v_string->s_data;
  101.             fp = sp;
  102.             break;
  103.         default:
  104.             error("Call to non-procedure, Type %s",
  105.               typename(sp[n].v_type));
  106.             return;
  107.         }
  108.         break;
  109.     case OP_RETURN:
  110.         if (fp == topframe) return;
  111.         val = *sp;
  112.         sp = fp;
  113.         pcoff = fp[0].v.v_integer;
  114.         n = fp[2].v.v_integer;
  115.         fp = stktop - fp[1].v.v_integer;
  116.         code = fp[fp[2].v.v_integer+3].v.v_bytecode;
  117.         cbase = code[1].v.v_string->s_data;
  118.         pc = cbase + pcoff;
  119.         sp += n + 3;
  120.         *sp = val;
  121.         break;
  122.     case OP_REF:
  123.         *sp = code[*pc++].v.v_var->de_value;
  124.         break;
  125.     case OP_SET:
  126.         code[*pc++].v.v_var->de_value = *sp;
  127.         break;
  128.     case OP_VREF:
  129.         chktype(0,DT_INTEGER);
  130.         switch (sp[1].v_type) {         case DT_VECTOR: vectorref(); break;
  131.         case DT_STRING: stringref(); break;
  132.         default:    badtype(1,DT_VECTOR); break;
  133.         }
  134.         break;
  135.     case OP_VSET:
  136.         chktype(1,DT_INTEGER);
  137.         switch (sp[2].v_type) {
  138.         case DT_VECTOR: vectorset(); break;
  139.         case DT_STRING: stringset(); break;
  140.         default:    badtype(1,DT_VECTOR); break;
  141.         }
  142.         break;
  143.     case OP_MREF:
  144.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  145.         *sp = obj[*pc++];
  146.         break;
  147.     case OP_MSET:
  148.         obj = fp[fp[2].v.v_integer+2].v.v_object;
  149.         obj[*pc++] = *sp;
  150.         break;
  151.     case OP_AREF:
  152.         n = *pc++;
  153.         if (n >= fp[2].v.v_integer)
  154.             error("Too few arguments");
  155.         *sp = fp[n+3];
  156.         break;
  157.     case OP_ASET:
  158.         n = *pc++;
  159.         if (n >= fp[2].v.v_integer)
  160.             error("Too few arguments");
  161.         fp[n+3] = *sp;
  162.         break;
  163.     case OP_TREF:
  164.         n = *pc++;
  165.         *sp = fp[-n-1];
  166.         break;
  167.     case OP_TSET:
  168.         n = *pc++;
  169.         fp[-n-1] = *sp;
  170.         break;
  171.     case OP_TSPACE:
  172.         n = *pc++;
  173.         check(n);
  174.         while (--n >= 0) {
  175.             --sp;
  176.             set_nil(sp);
  177.         }
  178.         break;
  179.     case OP_BRT:
  180.         if (istrue(sp))
  181.             pc = cbase + getwoperand();
  182.         else
  183.             pc += 2;
  184.         break;     case OP_BRF:
  185.         if (istrue(sp))
  186.             pc += 2;
  187.         else
  188.             pc = cbase + getwoperand();
  189.         break;
  190.     case OP_BR:
  191.         pc = cbase + getwoperand();
  192.         break;
  193.     case OP_NIL:
  194.         set_nil(sp);
  195.         break;
  196.     case OP_PUSH:
  197.         check(1);
  198.         push_integer(FALSE);
  199.         break;
  200.     case OP_NOT:
  201.         if (istrue(sp))
  202.             set_integer(sp,FALSE);
  203.         else
  204.             set_integer(sp,TRUE);
  205.         break;
  206.     case OP_NEG:
  207.         chktype(0,DT_INTEGER);
  208.         sp->v.v_integer = -sp->v.v_integer;
  209.         break;
  210.     case OP_ADD:
  211.         switch (sp[1].v_type) {
  212.         case DT_INTEGER:
  213.             switch (sp[0].v_type) {
  214.             case DT_INTEGER:
  215.             sp[1].v.v_integer += sp->v.v_integer;
  216.             break;
  217.             case DT_STRING:
  218.             s2 = sp[0].v.v_string;
  219.             sn = newstring(1 + s2->s_length);
  220.             sn->s_data[0] = sp[1].v.v_integer;
  221.             memcpy(&sn->s_data[1],
  222.                    s2->s_data,
  223.                    s2->s_length);
  224.             set_string(&sp[1],sn);
  225.             break;
  226.             default:
  227.             break;
  228.             }
  229.             break;
  230.         case DT_STRING:
  231.             s1 = sp[1].v.v_string;
  232.             switch (sp[0].v_type) {
  233.             case DT_INTEGER:
  234.             sn = newstring(s1->s_length + 1);
  235.             memcpy(sn->s_data,
  236.                    s1->s_data,
  237.                    s1->s_length);
  238.             sn->s_data[s1->s_length] = sp[0].v.v_integer;             set_string(&sp[1],sn);
  239.             break;
  240.             case DT_STRING:
  241.             s2 = sp[0].v.v_string;
  242.             sn = newstring(s1->s_length + s2->s_length);
  243.             memcpy(sn->s_data,
  244.                    s1->s_data,s1->s_length);
  245.             memcpy(&sn->s_data[s1->s_length],
  246.                    s2->s_data,s2->s_length);
  247.             set_string(&sp[1],sn);
  248.             break;
  249.             default:
  250.             break;
  251.             }
  252.             break;
  253.         default:
  254.             badtype(1,DT_VECTOR);
  255.             break;
  256.         }
  257.         ++sp;
  258.         break;
  259.     case OP_SUB:
  260.         chktype(0,DT_INTEGER);
  261.         chktype(1,DT_INTEGER);
  262.         sp[1].v.v_integer -= sp->v.v_integer;
  263.         ++sp;
  264.         break;
  265.     case OP_MUL:
  266.         chktype(0,DT_INTEGER);
  267.         chktype(1,DT_INTEGER);
  268.         sp[1].v.v_integer *= sp->v.v_integer;
  269.         ++sp;
  270.         break;
  271.     case OP_DIV:
  272.         chktype(0,DT_INTEGER);
  273.         chktype(1,DT_INTEGER);
  274.         if (sp->v.v_integer != 0) {
  275.             int x=sp->v.v_integer;
  276.             sp[1].v.v_integer /= x;
  277.         }
  278.         else
  279.             sp[1].v.v_integer = 0;
  280.         ++sp;
  281.         break;
  282.     case OP_REM:
  283.         chktype(0,DT_INTEGER);
  284.         chktype(1,DT_INTEGER);
  285.         if (sp->v.v_integer != 0) {
  286.             int x=sp->v.v_integer;
  287.             sp[1].v.v_integer %= x;
  288.         }
  289.         else
  290.             sp[1].v.v_integer = 0;
  291.         ++sp;
  292.         break;     case OP_INC:
  293.         chktype(0,DT_INTEGER);
  294.         ++sp->v.v_integer;
  295.         break;
  296.     case OP_DEC:
  297.         chktype(0,DT_INTEGER);
  298.         --sp->v.v_integer;
  299.         break;
  300.     case OP_BAND:
  301.         chktype(0,DT_INTEGER);
  302.         chktype(1,DT_INTEGER);
  303.         sp[1].v.v_integer &= sp->v.v_integer;
  304.         ++sp;
  305.         break;
  306.     case OP_BOR:
  307.         chktype(0,DT_INTEGER);
  308.         chktype(1,DT_INTEGER);
  309.         sp[1].v.v_integer |= sp->v.v_integer;
  310.         ++sp;
  311.         break;
  312.     case OP_XOR:
  313.         chktype(0,DT_INTEGER);
  314.         chktype(1,DT_INTEGER);
  315.         sp[1].v.v_integer ^= sp->v.v_integer;
  316.         ++sp;
  317.         break;
  318.     case OP_BNOT:
  319.         chktype(0,DT_INTEGER);
  320.         sp->v.v_integer = sp->v.v_integer;
  321.         break;
  322.     case OP_SHL:
  323.         switch (sp[1].v_type) {
  324.         case DT_INTEGER:
  325.             chktype(0,DT_INTEGER);
  326.             sp[1].v.v_integer <<= sp->v.v_integer;
  327.             break;
  328.         case DT_FILE:
  329.             print1(sp[1].v.v_fp,FALSE,&sp[0]);
  330.             break;
  331.         default:
  332.             break;
  333.         }
  334.         ++sp;
  335.         break;
  336.     case OP_SHR:
  337.         chktype(0,DT_INTEGER);
  338.         chktype(1,DT_INTEGER);
  339.         sp[1].v.v_integer >>= sp->v.v_integer;
  340.         ++sp;
  341.         break;
  342.     case OP_LT:
  343.         chktype(0,DT_INTEGER);
  344.         chktype(1,DT_INTEGER);
  345.         n = sp[1].v.v_integer < sp->v.v_integer;
  346.         ++sp;         set_integer(sp,n ? TRUE : FALSE);
  347.         break;
  348.     case OP_LE:
  349.         chktype(0,DT_INTEGER);
  350.         chktype(1,DT_INTEGER);
  351.         n = sp[1].v.v_integer <= sp->v.v_integer;
  352.         ++sp;
  353.         set_integer(sp,n ? TRUE : FALSE);
  354.         break;
  355.     case OP_EQ:
  356.         chktype(0,DT_INTEGER);
  357.         chktype(1,DT_INTEGER);
  358.         n = sp[1].v.v_integer == sp->v.v_integer;
  359.         ++sp;
  360.         set_integer(sp,n ? TRUE : FALSE);
  361.         break;
  362.     case OP_NE:
  363.         chktype(0,DT_INTEGER);
  364.         chktype(1,DT_INTEGER);
  365.         n = sp[1].v.v_integer != sp->v.v_integer;
  366.         ++sp;
  367.         set_integer(sp,n ? TRUE : FALSE);
  368.         break;
  369.     case OP_GE:
  370.         chktype(0,DT_INTEGER);
  371.         chktype(1,DT_INTEGER);
  372.         n = sp[1].v.v_integer >= sp->v.v_integer;
  373.         ++sp;
  374.         set_integer(sp,n ? TRUE : FALSE);
  375.         break;
  376.     case OP_GT:
  377.         chktype(0,DT_INTEGER);
  378.         chktype(1,DT_INTEGER);
  379.         n = sp[1].v.v_integer > sp->v.v_integer;
  380.         ++sp;
  381.         set_integer(sp,n ? TRUE : FALSE);
  382.         break;
  383.     case OP_LIT:
  384.         *sp = code[*pc++];
  385.         break;
  386.     case OP_SEND:
  387.         n = *pc++;
  388.         chktype(n,DT_OBJECT);
  389.         send(n);
  390.         break;
  391.     case OP_DUP2:
  392.         check(2);
  393.         sp -= 2;
  394.         *sp = sp[2];
  395.         sp[1] = sp[3];
  396.         break;
  397.     case OP_NEW:
  398.         chktype(0,DT_CLASS);
  399.         set_object(sp,newobject(sp->v.v_class));
  400.         break;     default:
  401.         info("Bad opcode %02x",pc[-1]);
  402.         break;
  403.     }
  404.     }
  405. }
  406.  
  407. /* send - send a message to an object */
  408. static send(n)
  409.   int n;
  410. {
  411.     char selector[TKNSIZE+1];
  412.     DICT_ENTRY *de;
  413.     CLASS *class;
  414.     class = sp[n].v.v_object[OB_CLASS].v.v_class;
  415.     getcstring(selector,sizeof(selector),sp[n-1].v.v_string);
  416.     sp[n-1] = sp[n];
  417.     do {
  418.     if ((de = findentry(class->cl_functions,selector)) != NULL) {
  419.         switch (de->de_value.v_type) {
  420.         case DT_CODE:
  421.         (*de->de_value.v.v_code)(n);
  422.         return;
  423.         case DT_BYTECODE:
  424.         check(3);
  425.         code = de->de_value.v.v_bytecode;
  426.         set_bytecode(&sp[n],code);
  427.         push_integer(n);
  428.         push_integer(stktop - fp);
  429.         push_integer(pc - cbase);
  430.         cbase = pc = code[1].v.v_string->s_data;
  431.         fp = sp;
  432.         return;
  433.         default:
  434.         error("Bad method, Selector '%s', Type %d",
  435.               selector,
  436.               de->de_value.v_type);
  437.         }
  438.     }
  439.     } while ((class = class->cl_base) != NULL);
  440.     nomethod(selector);
  441. }
  442.  
  443. /* vectorref - load a vector element */
  444. static vectorref()
  445. {
  446.     VALUE *vect;
  447.     int i;
  448.     vect = sp[1].v.v_vector;
  449.     i = sp[0].v.v_integer;
  450.     if (i < 0 || i >= vect[0].v.v_integer)
  451.     error("subscript out of bounds");
  452.     sp[1] = vect[i+1];
  453.     ++sp;
  454. } 
  455. /* vectorset - set a vector element */
  456. static vectorset()
  457. {
  458.     VALUE *vect;
  459.     int i;
  460.     vect = sp[2].v.v_vector;
  461.     i = sp[1].v.v_integer;
  462.     if (i < 0 || i >= vect[0].v.v_integer)
  463.     error("subscript out of bounds");
  464.     vect[i+1] = sp[2] = *sp;
  465.     sp += 2;
  466. }
  467.  
  468. /* stringref - load a string element */
  469. static stringref()
  470. {
  471.     STRING *str;
  472.     int i;
  473.     str = sp[1].v.v_string;
  474.     i = sp[0].v.v_integer;
  475.     if (i < 0 || i >= str->s_length)
  476.     error("subscript out of bounds");
  477.     set_integer(&sp[1],str->s_data[i]);
  478.     ++sp;
  479. }
  480.  
  481. /* stringset - set a string element */
  482. static stringset()
  483. {
  484.     STRING *str;
  485.     int i;
  486.     chktype(0,DT_INTEGER);
  487.     str = sp[2].v.v_string;
  488.     i = sp[1].v.v_integer;
  489.     if (i < 0 || i >= str->s_length)
  490.     error("subscript out of bounds");
  491.     str->s_data[i] = sp[0].v.v_integer;
  492.     set_integer(&sp[2],str->s_data[i]);
  493.     sp += 2;
  494. }
  495.  
  496. /* getwoperand - get data word */
  497. static int getwoperand()
  498. {
  499.     int b;
  500.     b = *pc++;
  501.     return ((*pc++ << 8) | b);
  502. }
  503.  
  504. /* type names */
  505. static char *tnames[] = {
  506. "NIL","CLASS","OBJECT","VECTOR","INTEGER","STRING","BYTECODE",
  507. "CODE","VAR","FILE"
  508. }; 
  509. /* typename - get the name of a type */
  510. static char *typename(type)
  511.   int type;
  512. {
  513.     static char buf[20];
  514.     if (type >= _DTMIN && type <= _DTMAX)
  515.     return (tnames[type]);
  516.     sprintf(buf,"(%d)",type);
  517.     return (buf);
  518. }
  519.  
  520. /* badtype - report a bad operand type */
  521. badtype(off,type)
  522.   int off,type;
  523. {
  524.     char tn1[20];
  525.     strcpy(tn1,typename(sp[off].v_type));
  526.     info("PC: %04x, Offset %d, Type %s, Expected %s",
  527.      pc-cbase,off,tn1,typename(type));
  528.     error("Bad argument type");
  529. }
  530.  
  531. /* nomethod - report a failure to find a method for a selector */
  532. static nomethod(selector)
  533.   char *selector;
  534. {
  535.     error("No method for selector '%s'",selector);
  536. }
  537.  
  538. /* stackover - report a stack overflow error */
  539. stackover()
  540. {
  541.     error("Stack overflow");
  542. }
  543.  
  544.  
  545.  
  546.  
  547. Example 1: 
  548.  
  549. (a) 
  550.  
  551.     factorial(n)
  552.     {
  553.         return n == 1 ? 1 : n * factorial(n-1);
  554.  
  555.     }
  556.  
  557.  
  558.  
  559. (b) 
  560.  
  561.  
  562.     main(; i)     {
  563.         for (i = 1; i <= 10; ++i)
  564.             print(i," factorial is ",factorial(i),"\n");
  565.     }
  566.  
  567.  
  568.  
  569. Example 2:
  570.  
  571. (a) A Bob class definition
  572.  
  573.     class foo
  574.     {
  575.         a,b;
  576.         static last;
  577.         static get_last();
  578.     }
  579.  
  580.  
  581. (b) 
  582.  
  583.     foo::foo(aa,bb)
  584.     {
  585.         a == aa; b = bb;
  586.         last = this;
  587.         return this;
  588.     }
  589.  
  590.  
  591.  
  592.  
  593.  
  594. Example 3:
  595.  
  596. (a)
  597.     foo::get_a()
  598.     {
  599.         return a;
  600.     }
  601.  
  602.  
  603.  
  604. (b)
  605.  
  606.     foo::set_a(aa)
  607.     {
  608.         a = aa;
  609.     }
  610.  
  611.  
  612. (c)
  613.  
  614.  
  615.     foo::count(; i)
  616.     {         for (i = a; i <= b; ++i)
  617.             print(i,"\n");
  618.     }
  619.  
  620.     main(; foo1,foo2)
  621.     {
  622.  
  623.         foo1 = new foo(1,2);      // create a object of class foo
  624.         foo2 = new foo(11,22);    // and another
  625.         print("foo1 counting\n"); // ask the first to count
  626.         foo1->count();
  627.         print("foo2 counting\n"); // ask the second to count
  628.         foo2->count();
  629.     }
  630.  
  631.  
  632. Example 4:
  633.  
  634. (a)
  635.  
  636.     class bar : foo // a class derived from foo
  637.     {
  638.         c;
  639.     }
  640.  
  641.  
  642. (b)
  643.  
  644.     bar::bar(aa,bb,cc)
  645.     {
  646.         this->foo(aa,bb);
  647.         return this;
  648.     }
  649.  
  650.  
  651.  
  652. Example 5
  653.  
  654. typedef struct value {
  655.   int v_type;           /* data type */
  656.   union {           /* value */
  657.     struct class *v_class;
  658.     struct value *v_object;
  659.     struct value *v_vector;
  660.     struct string *v_string;
  661.  
  662.     struct value *v_bytecode;
  663.     struct dict_entry *v_var;
  664.     int (*v_code)();
  665.     long v_integer;
  666.   } v;
  667. } VALUE;
  668.  
  669.  
  670.